home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / ttabldit / ttabldit.pas < prev    next >
Pascal/Delphi Source File  |  1996-04-08  |  2KB  |  113 lines
  1. unit Ttabldit;
  2. {TableDitto component written by Gabor Naszadi}
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes,DB, DBTables;
  7.  
  8. type
  9.   TStoreRec=record
  10.     IsEmpty:Boolean;
  11.     Buff   : Pointer;
  12.   end;
  13.  
  14.   pStoreRec=^TStoreRec;
  15.  
  16.   TTableDitto = class(TTable)
  17.   private
  18.     FMemory   :Tlist;
  19.     FDitto    :Boolean;
  20.     FFirstTime:Boolean;
  21.     procedure Allocate;
  22.   protected
  23.    procedure DoAfterPost; override;
  24.    procedure DoOnNewRecord; override;
  25.   public
  26.    constructor Create(AOwner:Tcomponent); override;
  27.    destructor  destroy; override;
  28.   published
  29.    property Ditto:Boolean read Fditto write Fditto;
  30.   end;
  31.  
  32. procedure Register;
  33.  
  34. implementation
  35. procedure   TTableDitto.Allocate;
  36.  var i :integer;
  37.      pP:pStoreRec;
  38.  begin
  39.   FMemory:=Tlist.create;
  40.   for i:=0 to Self.fieldcount-1 do
  41.   begin
  42.     New(pP);
  43.     GetMem(pP^.Buff, Self.Fields[i].DataSize);
  44.     FMemory.Add(pP);
  45.   end;
  46.   FDitto:=True;
  47.  end;
  48.  
  49. constructor  TTableDitto.Create(AOwner:Tcomponent);
  50.  begin
  51.   inherited Create(AOwner);
  52.   FFirstTime:=True;
  53.   FDitto:=True;
  54.  end;
  55.  
  56. destructor  TTableDitto.Destroy;
  57.  var i :integer;
  58.      pP:pStoreRec;
  59.  begin
  60.  if Not FFirstTime then
  61.  begin
  62.   for i:=0 to Self.fieldcount-1 do
  63.   begin
  64.     FreeMem(TStoreRec(FMemory.list^[i]^).Buff, Self.Fields[i].DataSize);
  65.     Dispose(FMemory.list^[i]);
  66.   end;
  67.   FMemory.Free;
  68.  end;
  69.  inherited Destroy;
  70.  end;
  71.  
  72. procedure TTableDitto.DoAfterPost;
  73.   var i:byte;
  74.  begin
  75.   If FFirstTime and FDitto
  76.    then
  77.     begin
  78.      Allocate;
  79.      FFirstTime:=False;
  80.     end;
  81.   If FDitto then
  82.   for i:=0 to Self.fieldcount-1 do
  83.   with Self.Fields[i],TStoreRec(fMemory.List^[i]^) do
  84.    if not Isnull
  85.    then
  86.     begin
  87.      GetData(Buff);
  88.      IsEmpty:=False;
  89.     end
  90.    else
  91.      IsEmpty:=True;
  92.   inherited DoAfterPost;
  93.  end;
  94.  
  95. procedure TTableDitto.DoOnNewRecord;
  96.   var i:byte;
  97.  begin
  98.   If FDitto and Not FFirstTime then
  99.   for i:=0 to Self.fieldcount-1 do
  100.    with Self.Fields[i],TStoreRec(fMemory.List^[i]^) do
  101.     If IsEmpty
  102.      then clear
  103.      else SetData(Buff);
  104.   inherited DoOnNewRecord;
  105.  end;
  106.  
  107. procedure Register;
  108. begin
  109.   RegisterComponents('Data Access', [TTableDitto]);
  110. end;
  111.  
  112. end.
  113.